home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
pascal
/
hugecoll.zip
/
HUGECOLL.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1992-07-25
|
18KB
|
748 lines
L{File name :HUGECOLL.PAS; Revision Date 23/5/1992 Size :556 Lines }
unit hugecoll; {implement huge collection in TurboPascal for Windows}
interface
{----------Huge Collection and Huge SortedCollection Object----------}
{ May 1992 }
{ Ver 0.1 (c) Nicholas Waltham, Oxford, United Kingdom }
{ <SPEEDY%UK.AC.OX.VAX@UKACRL> }
{ <100013.3330@COM.COMPUSERVE> }
{ }
{ Thanks to Jeroen Pluimers and other members of }
{ the Usenet community for memory handling advice }
{--------------------------------------------------------------------}
{ NB }
{ }
{ o Programs compiled with the only386 option defined will not run in }
{ real mode - but who runs a 386 in real mode anyway! }
{ o If anyone makes any significant alterations or has any bright ideas }
{ then please forward them to me so I can keep one up to date copy }
{ o This is supplied as is - there is no warrenty expressed or implied }
{ o This code is released to the public domain and may be freely copied }
{ No money must be charged for this code }
uses
Wintypes,WinProcs,WObjects,Strings;
{$I p:\shared\objid.inc}
{ This is a Pascal '.INC' file containing contants for all my object ids I have ever written
and prevents me from assigning the same id twice. You will need to define oidHugeCollection
and oidHugeSortedCollection constants for this unit}
{
{$DEFINE Only386}
{Define this flag is the subsequent code is only going to run on a 386base computer
or above - includes pointer calculation optimisation}
type
LongType = record
case Word of
0: (Ptr: Pointer);
1: (Long: Longint);
2: (Lo: Word;
Hi: Word);
end;
ppointer = ^pointer;
pHugeCollection = ^tHugeCollection;
tHugeCollection = Object (tObject)
Items : tHandle; {Handle to Global Memory}
Count : longint; {Current Number of Items}
Limit : longint; {Current Allocated size}
Delta : longint; {Number of items by which the collection grows when full}
base : longtype; {global pointer to memory when locked}
constructor init(aLimit, aDelta : Longint);
constructor Load(Var S : tStream);
destructor done; virtual;
function At (Index : Longint) : Pointer;
procedure AtDelete (Index : Longint);
procedure AtInsert (Index : Longint; Item : Pointer);
procedure AtPut (Index : Longint; Item : Pointer);
procedure Delete (Item : Pointer);
procedure DeleteAll;
procedure Error (Code,Info : Integer); virtual;
function FirstThat (Test : Pointer) : Pointer;
procedure ForEach (Action : Pointer);
procedure Free (Item : Pointer);
procedure FreeAll;
procedure FreeItem (Item : Pointer); virtual;
function GetItem (Var S : tStream) : Pointer; virtual;
function IndexOf (Item : Pointer) : longint; virtual;
procedure Insert (Item : Pointer); virtual;
function LastThat (Test : Pointer) : Pointer;
procedure Pack;
procedure PutItem (Var S : tStream; Item : Pointer); virtual;
procedure SetLimit (aLimit : Longint);virtual;
procedure Store (Var S : tStream);
procedure AtZero (Index : Longint);
procedure Lock;
procedure UnLock;
end;
pHugeSortedCollection = ^tHugeSortedCollection;
tHugeSortedCollection = Object(tHugeCollection)
function Compare (Key1,Key2 : Pointer): Integer; virtual;
function IndexOf (Item : Pointer): Longint; virtual;
procedure Insert (Item : Pointer); virtual;
function KeyOf (Item : Pointer): Pointer; virtual;
function Search (key : Pointer; Var Index : Longint) : Boolean; virtual;
end;
pCharHugeCollection = ^tCharHugeCollection;
tCharHugeCollection = Object(tHugeCollection)
procedure FreeItem (Item : Pointer); virtual;
end;
pStrHugeCollection = ^tStrHugeCollection;
tStrHugeCollection = Object(tHugeSortedCollection)
function Compare (Key1,Key2 : Pointer): Integer; virtual;
procedure FreeItem (Item : Pointer); virtual;
end;
const
RHugeCollection : tStreamRec =
(ObjType : oidHugeCollection;
VmtLink : Ofs(Typeof(tHugeCollection)^);
Load : @tHugeCollection.load;
Store : @tHugeCollection.Store);
RHugeSortedCollection : tStreamRec =
(ObjType : oidHugeSortedCollection;
VmtLink : Ofs(Typeof(tHugeSortedCollection)^);
Load : @tHugeSortedCollection.load;
Store : @tHugeSortedCollection.Store);
implementation
Procedure _AHShift; External 'KERNEL' Index 113;
procedure _AHIncr;far; external 'Kernel' index 114; {The MAGINC! function}
const
cAHShift = {Ofs(_AHShift)}3 ;{This won't work in real mode!}
AHShift : word = cAHShift;
cAHIncr = {Ofs(_AHShift)}8 ;{This won't work in real mode!}
AHIncr : word = cAHIncr;
{$IFDEF Only386}
function Compute(base : Pointer;aIndex : Longint) : Pointer;
inline(
$66/$5B {Pop EBX ; Load EBX with Index}
/$58 {Pop AX ; Load AX with Offset(base)
(Sensible since pointers are returned as DX:AX}
/$5A {Pop DX ; Load DX with Segment(base) }
/$66/$C1/$E3/$02 {SHL EBX,2 ; Multiply EBX by 4 }
/$03/$C3 {ADD AX,BX ; Add Lower half of pointer to AX}
/$33/$DB {XOR BX,BX ; Zero bottom 16bits of EBX }
/$66/$C1/$EB/<($10-cAHShift) {SHR EBX,16 - AHShift ; Shift Top of EBX into BX compensating for AHShift}
{This won't work in real mode}
/$03/$D3 {ADD DX,BX ; Add to BX}
);
{$ELSE}
function Compute(base : Pointer;aIndex : Longint) : Pointer;
INLINE(
$5B { POP BX }
/$5A { POP DX }
/$58 { POP AX }
/$D1/$E3 { SHL BX,1 }
/$D1/$D2 { RCL DX,1 }
/$D1/$E3 { SHL BX,1 }
/$D1/$D2 { RCL DX,1 }
/$03/$C3 { ADD AX,BX }
/$8B/$DA { MOV BX,DX }
/$5A { POP DX }
/$8B/$0E/>AHShift { MOV CX,word([AHSHIFT]) }
/$D3/$E3 { SHL BX,CL }
/$03/$D3 { ADD DX,BX